home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / prftest.exe / PROFUNIT.PAS < prev   
Pascal/Delphi Source File  |  1992-04-14  |  15KB  |  466 lines
  1. Unit ProfUnit;
  2.  
  3. {=====================================================================}
  4. {===== This code implements two standard Windows functions,      =====}
  5. {===== WritePrivateProfileString and GetPrivateProfileString.    =====}
  6. {===== In addition, a parsing function is included,              =====}
  7. {===== ParseProfileString, which is useful for parsing the       =====}
  8. {===== buffer returned by the Get... function.  This Pascal      =====}
  9. {===== implementation is an attempt to apply those functions     =====}
  10. {===== as well as the general notion of the ".INI" file to       =====}
  11. {===== DOS environment.  I've tried to make the functions        =====}
  12. {===== work exactly like their Windows API counterparts.  To     =====}
  13. {===== differentiate between the environments, my functions are  =====}
  14. {===== called WriteDOSProfileString and GetDOSProfileString.     =====}
  15. {=====                                                           =====}
  16. {===== Note that the arguments for all functions ARE CASE        =====}
  17. {===== SENSITIVE.  I will be adding code to resolve that as soon =====}
  18. {===== as I have the chance.  If there is any interest in this   =====}
  19. {===== code, I will upload updates as they are implemented.  If  =====}
  20. {===== there are any suggestions, please email to me on either:  =====}
  21. {=====                                                           =====}
  22. {=====          X.400:(c=us,a=attmail,d=id:mvabbc!wmpotvin)      =====}
  23. {=====   or                                                      =====}
  24. {=====          70540,120                                        =====}
  25. {=====                                                           =====}
  26. {===== Copyright(c) 1992 Wm Potvin II                            =====}
  27. {=====================================================================}
  28.  
  29. Interface
  30.  
  31. Uses
  32.   Dos;
  33.  
  34. Type
  35.   StrArray = array [1..80] of String[80];
  36.   ProfStr = String[255];
  37.   LinePtr = ^LineRecType;
  38.   LineRecType = Record
  39.     NextLine  : LinePtr;
  40.     LineField : ProfStr;
  41.   end;
  42.  
  43. Var
  44.   P1, P2, P3,
  45.   KeyUpDated,
  46.   AppUpDated,
  47.   KeyFound,
  48.   AppFound   : Boolean;
  49.   F          : Text;                     { File handle    }
  50.   Head       : LinePtr;                  { Head of List   }
  51.   Hold       : LinePtr;                  { Place Holder   }
  52.   Cur        : LinePtr;                  { Current Line   }
  53.   LineBuf    : ProfStr;                  { Input String   }
  54.   LineFieldIndex,
  55.   Count,
  56.   CountEnd,
  57.   Index,
  58.   BufIndex : Integer;
  59.  
  60. function WriteDOSProfileString(AppName,
  61.                                KeyName,
  62.                                Str: String;
  63.                                FileName: PathStr): Boolean;
  64.  
  65. function GetDOSProfileString(AppName,
  66.                              KeyName,
  67.                              Default: ProfStr;
  68.                              var RecvBuf: ProfStr;
  69.                              Size: Integer;
  70.                              FileName: PathStr): Integer;
  71.  
  72. function ParseProfileString(ProfileBuffer: ProfStr;
  73.                             var ReturnedArray: StrArray): Integer;
  74.  
  75. function ASCIIToUpper(StrBuffer: String): String;
  76.  
  77. Implementation
  78.  
  79. function WriteDOSProfileString(AppName,
  80.                                KeyName,
  81.                                Str: String;
  82.                                FileName: PathStr): Boolean;
  83.  
  84.  {***** Support Functions *****}
  85.  
  86.   function DeleteLine(DeleteStr: ProfStr): Boolean;
  87.   { deletes the line of the buffer containing DeleteStr. }
  88.   var
  89.     Count : Integer;
  90.   begin
  91.     DeleteLine := FALSE;
  92.     Hold := Head;
  93.     Cur := Head^.NextLine;
  94.     Count := 1;
  95.     while (Cur <> NIL) AND (Pos(DeleteStr, Cur^.LineField) = 0) do
  96.       begin
  97.         Hold := Cur;              { Save Current pointer }
  98.         Cur  := Cur^.NextLine;    { Advance to next line }
  99.       end;
  100.     if (Cur <> NIL) AND (Pos(DeleteStr, Cur^.LineField) <> 0) then
  101.       begin
  102.         Hold^.NextLine := Cur^.NextLine; {  skip current line }
  103.         FreeMem(Cur, Length(Cur^.LineField) + 5);
  104.         DeleteLine := TRUE;
  105.       end;
  106.   end;
  107.  
  108.   function DeleteAppName(DeleteAppStr: ProfStr): Boolean;
  109.   { deletes an entire App Section of the buffer containing DeleteAppStr. }
  110.   var
  111.     Count : Integer;
  112.   begin
  113.     DeleteAppName := FALSE;
  114.     Hold := Head;
  115.     Cur := Head^.NextLine;
  116.     while (Cur <> NIL) AND (Pos(DeleteAppStr, Cur^.LineField) < 2) do
  117.       begin
  118.         Hold := Cur;              { Save Current pointer }
  119.         Cur  := Cur^.NextLine;    { Advance to next line }
  120.       end;
  121.     if (Cur <> NIL) AND (Pos(DeleteAppStr, Cur^.LineField) <> 0) then
  122.       begin
  123.         while (Cur <> NIL) AND (Cur^.LineField <> ' ') do
  124.           begin
  125.             Hold^.NextLine := Cur^.NextLine; {  skip current line }
  126.             FreeMem(Cur, Length(Cur^.LineField) + 5);
  127.             Cur := Hold^.NextLine;
  128.           end;
  129.         DeleteAppName := TRUE;
  130.       end;
  131.   end;
  132.  
  133.   function InsertLine(NewStr: ProfStr): Boolean;
  134.   { inserts the line ProfStr after the last line under the AppName. }
  135.   var
  136.     NewLine: LinePtr;
  137.   begin
  138.     InsertLine := FALSE;
  139.     Hold := Head;
  140.     Cur  := Head^.NextLine;
  141.     while (Cur <> NIL) do
  142.       begin
  143.         Hold  := Cur;                      { Save current pointer }
  144.         Cur   := Cur^.NextLine;            { Advance to next line }
  145.         if (Hold^.LineField = '') AND      { if the old line is blank, }
  146.           (Cur^.LineField = '') then       { and the current line, too }
  147.             Cur := NIL;
  148.       end;
  149.     GetMem(NewLine, Length(NewStr) + 5);
  150.     Hold^.NextLine := NewLine;    { Change pointers to link }
  151.     NewLine^.NextLine := Cur;     {   in the new line       }
  152.     NewLine^.LineField := NewStr;
  153.     InsertLine := TRUE;
  154.   end;
  155.  
  156.   function InsertAppName(NewApp: ProfStr): Boolean;
  157.   var
  158.     P4, P5: Boolean;
  159.   begin
  160.     P4 := InsertLine('');
  161.     P5 := InsertLine(ConCat('[', AppName, ']'));
  162.   end;
  163.  
  164.   function LoadFile: Boolean;
  165.   {loads the file into a linked list }
  166.   begin
  167.     FileName := FExpand(FileName);
  168.     Assign(F, FileName);
  169.     {$I-}
  170.     Reset(F);
  171.     {I+} ;
  172.     if (IOResult = 0) then
  173.       begin
  174.         GetMem(Head, 4);
  175.         Head^.NextLine := NIL;              { Initialize Head }
  176.         Hold := Head;
  177.         while NOT Eof(F) do
  178.           begin
  179.             ReadLn(F, LineBuf);
  180.             GetMem(Cur, Length(LineBuf)+5); { Allocate Memory }
  181.             Hold^.NextLine := Cur;          { Set previous pointer }
  182.             Cur^.NextLine  := NIL;          { Cur goes at end of list }
  183.             Hold := Cur;                    { Save Current pointer }
  184.             Cur^.LineField := LineBuf;
  185.           end;
  186.         Close(F);
  187.         LoadFile := TRUE;
  188.       end
  189.     else
  190.       LoadFile := FALSE
  191.   end;
  192.  
  193.   function WriteFile: Boolean;
  194.   { traverse the list and write each line }
  195.   begin
  196.     FileName := FExpand(FileName);
  197.     Assign(F, FileName);
  198.     {$I-}
  199.     ReWrite(F);
  200.     {I+} ;
  201.     if (IOResult = 0) then
  202.       begin
  203.         Cur := Head^.NextLine;
  204.         while Cur <> NIL do
  205.           begin
  206.             WriteLn(F, Cur^.LineField);
  207.             Cur := Cur^.NextLine;
  208.           end;
  209.         Close(F);
  210.         WriteFile := TRUE;
  211.       end
  212.     else
  213.       WriteFile := FALSE;
  214.   end;
  215.  
  216.   {***** Begin Main Function *****}
  217.  
  218. begin
  219.   P1 := LoadFile;
  220.   if P1 then
  221.     begin
  222.       Cur := Head^.NextLine;
  223.       KeyUpDated := FALSE;
  224.       AppUpDated := FALSE;
  225.       while Cur <> NIL do
  226.         begin
  227.           if (KeyName = 'nil') then
  228.             begin
  229.               P3 := DeleteAppName(AppName);
  230.               P3 := WriteFile;
  231.               if P3 then
  232.                 WriteDOSProfileString := TRUE
  233.               else
  234.                 WriteDOSProfileString := FALSE;
  235.               Exit;
  236.             end
  237.           else
  238.           if Pos(AppName, Cur^.LineField) = 2 then
  239.             begin
  240.               while NOT AppUpdated do
  241.               begin
  242.               AppUpdated := TRUE;
  243.               Cur := Cur^.NextLine;
  244.               if Pos(KeyName, Cur^.LineField) = 1 then
  245.                 begin
  246.